Rental Listings Demo

library(rental)
library(cancensus)
library(tidyverse)
library(sf)

Listings Overview

As an example we read the August data for unfurnished listings for Vancouver, Calgary and Toronto.

Reading regions list from local cache.
Cached regions list may be out of date. Set `use_cache = FALSE` to update it.Reading geo data from local cache.

[1] "Toronto (C)"

[1] "Calgary (CY)"

[1] "Vancouver (CY)"

Vancouver over time

regions=list_census_regions('CA16', use_cache = TRUE) %>% filter(level=="CSD",name == "Vancouver")

Reading regions list from local cache.
Cached regions list may be out of date. Set `use_cache = FALSE` to update it.

geo=get_census(dataset = 'CA16',regions=as_census_region_list(regions),geo_format='sf',level="Regions")

Reading geo data from local cache.

start_time="2017-05-01"
end_time="2017-12-16"
  ls <- get_listings(start_time,end_time,geo$geometry,filter = 'unfurnished')
  summary=ls %>% as.data.frame %>% select("price","beds") %>% group_by(beds) %>% summarize(median=paste0("$",format(median(price),big.mark=",")), count=n()) %>% mutate(name="Vancouver")
  

ls<-st_as_sf(ls)
base=getOption("custom_data_path")
nbhds=st_read(paste0(base,"local_area_boundary_shp/local_area_boundary.shp")) %>% st_transform(4326)

Reading layer `local_area_boundary' from data source `/Users/jens/.custom_data/local_area_boundary_shp/local_area_boundary.shp' using driver `ESRI Shapefile'
Simple feature collection with 22 features and 2 fields
geometry type:  POLYGON
dimension:      XY
bbox:           xmin: 483644.8 ymin: 5449580 xmax: 498313 ymax: 5460349
epsg (SRID):    26910
proj4string:    +proj=utm +zone=10 +datum=NAD83 +units=m +no_defs

downtown=st_read(paste0(base,"downtown_yvr.geojson"))

Reading layer `OGRGeoJSON' from data source `/Users/jens/.custom_data/downtown_yvr.geojson' using driver `GeoJSON'
Simple feature collection with 1 feature and 0 fields
geometry type:  POLYGON
dimension:      XY
bbox:           xmin: -123.1684 ymin: 49.26915 xmax: -123.1004 ymax: 49.31595
epsg (SRID):    4326
proj4string:    +proj=longlat +datum=WGS84 +no_defs

yaletown=st_read(paste0(base,"yaletown.geojson"))

Reading layer `OGRGeoJSON' from data source `/Users/jens/.custom_data/yaletown.geojson' using driver `GeoJSON'
Simple feature collection with 1 feature and 0 fields
geometry type:  POLYGON
dimension:      XY
bbox:           xmin: -123.1274 ymin: 49.27282 xmax: -123.1148 ymax: 49.27791
epsg (SRID):    4326
proj4string:    +proj=longlat +datum=WGS84 +no_defs

westend=st_read(paste0(base,"westend.geojson"))

Reading layer `OGRGeoJSON' from data source `/Users/jens/.custom_data/westend.geojson' using driver `GeoJSON'
Simple feature collection with 1 feature and 0 fields
geometry type:  POLYGON
dimension:      XY
bbox:           xmin: -123.1491 ymin: 49.27626 xmax: -123.1229 ymax: 49.29423
epsg (SRID):    4326
proj4string:    +proj=longlat +datum=WGS84 +no_defs

ls$downtown=as.logical(st_intersects(ls,downtown))

although coordinates are longitude/latitude, st_intersects assumes that they are planar

ls$westend=as.logical(st_intersects(ls,westend))

although coordinates are longitude/latitude, st_intersects assumes that they are planar

ls$yaletown=as.logical(st_intersects(ls,yaletown))

although coordinates are longitude/latitude, st_intersects assumes that they are planar

ls$nbhd_dtn=as.logical(st_intersects(ls,nbhds %>% filter(NAME=="Downtown")))

although coordinates are longitude/latitude, st_intersects assumes that they are planar

ls <- ls %>% mutate(
  nbhd_dtn=ifelse(is.na(nhd_dtn),FALSE,nhd_dtn),
  downtown=ifelse(is.na(downtown),FALSE,downtown),
  westend=ifelse(is.na(westend),FALSE,westend),
  yaletown=ifelse(is.na(yaletown),FALSE,yaletown)
  )
ls <- st_join(ls,nbhds)

although coordinates are longitude/latitude, st_intersects assumes that they are planar

ggplot(nbhds, aes(fill=NAME)) +geom_sf()

area="Renfrew-Collingwood"
plot_data <- ls %>% filter(NAME==area,as.integer(beds)<3, price<5000) %>% mutate(beds=ifelse(as.integer(beds)>=5,"5+",beds))
  ggplot(plot_data, aes(x=post_date, y=price, color=beds,group=beds)) + 
  geom_point(size=0.01,alpha=0.2) +
  geom_smooth(method = "loess", se = FALSE) +
    scale_color_discrete(name="Bedrooms") +
    theme_bw() +
    labs(title=paste0(area," Listings (unfurnished) ",format(nrow(plot_data))),x="Date",y="Asking Rent")

NA

plot_data <- ls %>% filter(as.integer(beds)<3, downtown==TRUE, price<5000) %>% mutate(ppsf=price/size) %>% filter(!is.na(ppsf) & ppsf<7.5)
  ggplot(plot_data, aes(x=post_date, y=ppsf, color=beds,group=beds)) + 
  geom_point(size=0.01,alpha=0.2) +
  geom_smooth(method = "loess", se = FALSE) +
    theme_bw()

plot_data <- ls %>% filter(as.integer(beds)<=2) %>% mutate(beds=ifelse(as.integer(beds)>=5,"5+",beds),
                           type=paste0(beds, ifelse(downtown," downtown","")))
# totals <- plot_data %>%
#   group_by(downtown,beds) %>% summarize(price,sub)
  ggplot(plot_data, aes(x=post_date, y=price, color=type,group=type)) + 
  geom_point(size=0.01,alpha=0.2) +
    scale_color_brewer(palette = "Paired") +
  geom_smooth(method = "loess", se = FALSE) +
    theme_bw()

Map

library(sf)
library(ggplot2)
geo=get_census(dataset = 'CA16',regions=list(CMA="59933"),geo_format='sf',level="Regions")
ls <- get_listings(start_time,end_time,geo$geometry,beds=c(1),filter = 'unfurnished')
  summary=ls %>% as.data.frame %>% select("price","beds") %>% group_by(beds) %>% summarize(median=paste0("$",format(median(price),big.mark=","))) %>% mutate(name=row$name)
cts=get_census(dataset = 'CA16',regions=list(CMA="59933"),geo_format='sf',level="CSD")
min_listings=10
median_rent <- function(v){
  result <- ifelse(length(v)>min_listings, median(v),NA)
  return(result)
}
aggregate_listings <- aggregate(cts %>% select("GeoUID"),ls,function(x){x})
data <- aggregate(ls %>% select("price"),cts,median_rent)
cutoffs=as.integer(quantile(data$price, probs=seq(0,1,0.1), na.rm=TRUE))
labels=factor(as.character(seq(1,length(cutoffs)-1) %>% lapply(function(i){return(paste0(cutoffs[i]," - ",cutoffs[i+1]))})),order=TRUE)
colors=setNames(RColorBrewer::brewer.pal(length(labels),"RdYlBu"),labels)
data$discrete_price= data$price %>% cut(breaks=cutoffs, labels=labels)
ggplot() +
  geom_sf(data=cts, fill="#808080", size=0.1) +
  geom_sf(data=data, aes(fill = discrete_price), size=0.1) +
  scale_fill_brewer(palette='RdYlBu', direction=-1, na.value="#808080",name="Median Price") +
  labs(title="August Studio and 1 Bedroom Unfurnished Median Ask") +
  theme_opts

Rent distributions by municipality

Looking into Coquitlam

region_name="Coquitlam" #"Richmond"
regions=as_census_region_list(search_census_regions(region_name,'CA16','CSD') %>% filter(name==region_name))
geo=get_census(dataset = 'CA16',regions=regions,geo_format='sf',level="Regions")
ls <- get_listings(start_time,end_time,geo$geometry,beds=c(1),filter = 'unfurnished',sanity=c(400,4000))
summary=ls %>% as.data.frame %>% 
  select("price","beds") %>% 
  group_by(beds) %>%
  summarize(median=paste0("$",format(median(price),big.mark=","))) %>% 
  mutate(name=row$name)
cutoffs=c(400,1350,4000)
labels=factor(as.character(seq(1,length(cutoffs)-1) %>% lapply(function(i){return(paste0(cutoffs[i]," - ",cutoffs[i+1]))})),order=TRUE)
colors=setNames(c("turquoise","purple"),labels)
ls$discrete_price= ls$price %>% cut(breaks=cutoffs, labels=labels)
#ls <- cbind(ls,st_coordinates(st_transform(ls,102002)$location))
ls <- cbind(ls,st_coordinates(ls$location))
library(ggmap)

base <- get_map(paste0(region_name,", Canada"), zoom=12, source = "stamen", maptype = "toner", 
    crop = T)
#ggplot() +
  ggmap(base) +
  #geom_sf(data=geo, fill="#808080", size=0.1) +
  #coord_sf(crs=st_crs(102002)) +
  geom_point(data=ls , aes(color = discrete_price, x=X, y=Y), shape=21, size=2) +
  scale_fill_manual(palette=colors) +
  labs(title="August Studio and 1 Bedroom Unfurnished Median Ask",color="Price") +
  theme_opts

Rent distributions over time

region_name="Vancouver" 
regions=as_census_region_list(search_census_regions(region_name,'CA16','CSD') %>% filter(name==region_name))
geo=get_census(dataset = 'CA16',regions=regions,geo_format='sf',level="Regions")
ls <- get_listings(start_time,end_time,geo$geometry,beds=c(1),filter = 'unfurnished',sanity=c(400,4000))
ls$year_month <- factor(substr(ls$post_date,0,7),ordered = TRUE)
#ls$year_month_day <- factor(substr(ls$post_date,0,10),ordered = TRUE)
 
#ls %>% group_by(year_month) %>% summarize(count=length(year_month)) %>% as.data.frame %>% select("year_month","count")
#ls %>% group_by(year_month_day) %>% summarize(count=length(year_month_day)) %>% as.data.frame %>% select("year_month_day","count")
  
 
plot_data <- ls %>% as.data.frame %>% select("price","year_month")
title="Distribution of Unfurnished 1br Rents, City of Vancouver"
p1 <- ggplot(plot_data) + 
  geom_density(aes(x=price, color=year_month)) +
  labs(title=title, color="Year-Month")
p2 <- ggplot(plot_data, aes(year_month, price))+ 
  geom_violin(aes(fill=year_month )) + 
  #geom_beeswarm(pch = 1, col='white', cex=0.8, alpha=0.6) +
  labs(title=title, fill="Year-Month", x="Year-Month")
grid.arrange(p1, p2, ncol=1)

Rent distributions by municipality

library(ggbeeswarm)
library(gridExtra)
region_names=c("Vancouver","Toronto","Victoria","Calgary")
regions= as_census_region_list(do.call(rbind,lapply(region_names,function(region_name){return((search_census_regions(region_name,'CA16','CSD') %>% filter(name==region_name)))})))
geo=get_census(dataset = 'CA16',regions=regions,geo_format='sf',level="Regions")
geometry=st_union(geo$geometry)
beds=2
ls <- get_listings(start_time,end_time,geometry,beds=c(beds),filter = 'unfurnished',sanity=c(400,5000))
  summary=ls %>% as.data.frame %>% select("price","beds") %>% group_by(beds) %>% summarize(median=paste0("$",format(median(price),big.mark=","))) %>% mutate(name=row$name)
  
geos=get_census(dataset = 'CA16',regions=regions,geo_format='sf',level="CSD") %>%
  st_join(ls) 
plot_data <- geos %>% as.data.frame %>% select("name","price") %>%
  rename(Municipality=name)
title=paste0("Distribution of Unfurnished ",beds,"br Rents, August 2017")
p1 <- ggplot(plot_data) + 
  geom_density(aes(x=price, color=Municipality)) +
  labs(title=title)
p2 <- ggplot(plot_data, aes(Municipality, price))+ 
  geom_violin(aes(fill=Municipality )) + 
  #geom_beeswarm(pch = 1, col='white', cex=0.8, alpha=0.6) +
  labs(title=title)
grid.arrange(p1, p2, ncol=1)

Checking Specific area

#geo=sf::read_sf("../data/custom_region.geojson")
geo=sf::read_sf("../data/victoria_stainsbury.geojson")
ls <- get_listings("2017-06-01","2017-09-01",geo$geometry,filter = 'unfurnished')
  summary=ls %>% as.data.frame %>% select("price","beds") %>% group_by(beds) %>% summarize(median=paste0("$",format(median(price),big.mark=","))) %>% mutate(name=row$name)
  ggplot(ls, aes(beds, price))+ 
  geom_violin(aes(fill=beds )) + 
  #geom_beeswarm(pch = 1, col='white', cex=0.8, alpha=0.6) +
  labs(title="June-August 1br unfurnished Custom Region")

NA

cutoffs=c(400,1050,4000)
labels=factor(as.character(seq(1,length(cutoffs)-1) %>% lapply(function(i){return(paste0(cutoffs[i]," - ",cutoffs[i+1]))})),order=TRUE)
colors=setNames(c("turquoise","purple"),labels)
ls$discrete_price= ls$price %>% cut(breaks=cutoffs, labels=labels)
ls <- cbind(ls,st_coordinates(ls$location))
base <- get_map(location=c(-122.84594535827637, 49.18422801616818), zoom=15, source = "stamen", maptype = "toner", 
    crop = T)

Map from URL : http://maps.googleapis.com/maps/api/staticmap?center=49.184228,-122.845945&zoom=15&size=640x640&scale=2&maptype=terrain&sensor=false
Map from URL : http://tile.stamen.com/toner/15/5201/11226.png
Map from URL : http://tile.stamen.com/toner/15/5202/11226.png
Map from URL : http://tile.stamen.com/toner/15/5203/11226.png
Map from URL : http://tile.stamen.com/toner/15/5201/11227.png
Map from URL : http://tile.stamen.com/toner/15/5202/11227.png
Map from URL : http://tile.stamen.com/toner/15/5203/11227.png
Map from URL : http://tile.stamen.com/toner/15/5201/11228.png
Map from URL : http://tile.stamen.com/toner/15/5202/11228.png
Map from URL : http://tile.stamen.com/toner/15/5203/11228.png

#ggplot() +
  ggmap(base) +
  #geom_sf(data=geo, fill="#808080", size=0.1) +
  #coord_sf(crs=st_crs(102002)) +
  geom_point(data=ls , aes(color = discrete_price, x=X, y=Y), shape=21, size=4) +
  scale_fill_manual(palette=colors) +
  geom_polygon(data= fortify(as(geo,"Spatial")), aes(x=long, y=lat), fill=NA, size=0.5,color='blue') +
  labs(title="August 1 Bedroom Unfurnished Median Ask",color="Price") +
  theme_opts

Regions defined for each Polygons

my_theme <- list(
  theme_minimal(),
  theme(axis.text = element_blank(), 
        axis.title = element_blank(), 
        axis.ticks = element_blank(),
        panel.grid.major = element_line(colour = "white"), 
        panel.grid.minor = element_line(colour = "white"),
        panel.background = element_blank(), 
        axis.line = element_blank())
)

Vancouver rent map

Reading regions list from local cache.
Reading geo data from local cache.
the condition has length > 1 and only the first element will be usedalthough coordinates are longitude/latitude, st_intersects assumes that they are planar